home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / datetime.swg / 0051_DAYS UNTIL-SINCE CALC'ING.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-28  |  2.4 KB  |  89 lines
  1. {
  2. If you are only concerned about dates since 1582, you can translate
  3. both the Current date and the Other date into a LONGINT, and subtract
  4. one from the other.
  5.  
  6. Below I have a calendar code fragment that writes out the Current
  7. date as a LONGINT.  It should be a trivial task to integrate it into
  8. an operational program, and have it do what you want.
  9.  
  10. {======================[ cut here ]======================}
  11.  
  12. USES DOS;
  13.  
  14. CONST DaysPerYear = 365;
  15.  
  16. TYPE Month = (Jan, Feb, Mar, Apr, May, Jun, Jul, Aug, Sep, Oct, Nov, Dec);
  17.              (* REMEMBER: ORD values for Month are 0..11 - NOT 1..12 ! *)
  18.      Date = RECORD
  19.               da: 1..31;
  20.               mo: Month;
  21.               yr: 1..9999
  22.             END;
  23.  
  24.  VAR maxDay: ARRAY [Month] OF INTEGER;
  25.      daysBefore: ARRAY [Month] OF INTEGER;
  26.  
  27. PROCEDURE GetSysDate(VAR d: Date);
  28.   (* Reads the system clock and assigns the date to d
  29.      and the day of the week to dayOfWeek.            *)
  30.   VAR SysYear,SysMonth,SysDay,SysDOW : word;
  31. BEGIN
  32.   GetDate(SysYear,SysMonth,SysDay,SysDOW);
  33.   d.yr := SysYear;
  34.   d.mo := Month(SysMonth-1);
  35.   d.da := SysDay
  36. { dayOfWeek := DayType(SysDOW+1);   }
  37. END;
  38.  
  39. PROCEDURE MonthsInit;
  40.   VAR mo: Month;
  41. BEGIN
  42.   maxDay[Jan] := 31;
  43.   maxDay[Feb] := 28;  (* adjust for leap years later *)
  44.   maxDay[Mar] := 31;
  45.   maxDay[Apr] := 30;
  46.   maxDay[May] := 31;
  47.   maxDay[Jun] := 30;
  48.   maxDay[Jul] := 31;
  49.   maxDay[Aug] := 31;
  50.   maxDay[Sep] := 30;
  51.   maxDay[Oct] := 31;
  52.   maxDay[Nov] := 30;
  53.   maxDay[Dec] := 31;
  54.  
  55.   daysBefore[Jan] := 0;
  56.   FOR mo := Jan TO Nov DO
  57.     daysBefore[Month(ORD(mo)+1)] := daysBefore[mo] + maxDay[mo]
  58. END;
  59.  
  60. FUNCTION IsLeapYear(Const yr: INTEGER): BOOLEAN;
  61. BEGIN
  62.   IsLeapYear := ((yr MOD 4 = 0) AND (yr MOD 100 <> 0)) OR (yr MOD 400 = 0)
  63. END;
  64.  
  65. FUNCTION NumDays(CONST d: Date): LONGINT;
  66.   (* NumDays returns an ordinal value for the date
  67.      with January 1, 0001 assigned the value 1.    *)
  68.   VAR result, leapYears, lYr: LONGINT;
  69. BEGIN
  70.   WITH d DO BEGIN
  71.     lYr:=yr-1;
  72.     result := (da);
  73.     INC(result, daysBefore[mo]);
  74.     INC(result,lYr * DaysPerYear);
  75.     leapYears := (lYr DIV 4) - (lYr DIV 100) + (lYr DIV 400);
  76.     INC(result, leapYears);
  77.     IF (mo > Feb) AND IsLeapYear(yr) THEN INC(result)
  78.   END;
  79.   NumDays := result
  80. END;
  81.  
  82. VAR currentDay : date;
  83.  
  84. begin
  85.   GetSysDate(currentDay);
  86.   MonthsInit;
  87.   Writeln(NumDays(currentDay));
  88. end.
  89.